CZ_COVID-19 Projekce umrti

Long-term scenarios of daily deaths

interactive chart

CZ_expected_deaths_timeline_projected_end <- CZ_expected_deaths_timeline_projected %>%
  filter(date_expected_death == as.Date("30/11/2020", format = "%d/%m/%Y"))

CZ_expected_deaths_timeline_projected_summary <- CZ_expected_deaths_timeline_projected %>%
  mutate(month = month(date_expected_death)) %>%
  group_by(month, Scenario) %>%
  summarise(expected_deaths = sum(expected_deaths))


ggplotly(
CZ_expected_deaths_timeline_projected %>% 
  left_join(CZ_all, by = c("date_expected_death" = "date")) %>%
  filter(date_expected_death <= as.Date("30/11/2020", format = "%d/%m/%Y")) %>%
  ggplot(aes(x = date_expected_death, y = round(expected_deaths_7,2), col = Scenario)) +
  geom_line(size = 1) +
  geom_text_repel(aes(label = round(expected_deaths_7,0), colour = Scenario), data = CZ_expected_deaths_timeline_projected_end, size = 3, vjust = 0, hjust = -200) +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = new_deaths_7), col = "black", size = 1) +
  geom_vline(xintercept = date_model, col = "red", linetype = "dashed") +
  scale_color_manual(values = c("#377EB8", "#4DAF4A", "purple", "#E41A1C")) +
  scale_x_date(date_breaks = "1 month", date_minor_breaks = "1 week", date_labels="%b") +
  theme_light() +
  theme(panel.grid.minor = element_blank(),
        legend.position = "bottom") +
  guides(color=guide_legend(nrow=2,byrow=TRUE)) +
  labs(y = "Deaths (7 day rolling average)", x = "", title = "Long-term scenarios of expected daily deaths", subtitle = "Based on past data and 4 scenarios of growth in cases") 
) %>%
  layout(legend = list(
    orientation = "h",
    x = -0,
    y = -0.1
  )
)

non-interactive version

CZ_expected_deaths_timeline_projected_end <- CZ_expected_deaths_timeline_projected %>%
  filter(date_expected_death == as.Date("30/11/2020", format = "%d/%m/%Y"))

CZ_expected_deaths_timeline_projected_summary <- CZ_expected_deaths_timeline_projected %>%
  mutate(month = month(date_expected_death)) %>%
  group_by(month, Scenario) %>%
  summarise(expected_deaths = sum(expected_deaths))



CZ_expected_deaths_timeline_projected %>% 
  left_join(CZ_all, by = c("date_expected_death" = "date")) %>%
  filter(date_expected_death <= as.Date("30/11/2020", format = "%d/%m/%Y")) %>%
  ggplot(aes(x = date_expected_death, y = round(expected_deaths_7,2), col = Scenario)) +
  geom_line(size = 1) +
  geom_text_repel(aes(label = round(expected_deaths_7,0), colour = Scenario), data = CZ_expected_deaths_timeline_projected_end, size = 3, vjust = 0, hjust = -1) +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = new_deaths_7), col = "black", size = 1) +
  geom_vline(xintercept = date_model, col = "red", linetype = "dashed") +
  scale_color_manual(values = c("#377EB8", "#4DAF4A", "purple", "#E41A1C")) +
  scale_x_date(date_breaks = "1 month", date_minor_breaks = "1 week", date_labels="%b") +
  theme_light() +
  theme(panel.grid.minor = element_blank(),
        legend.position = "bottom") +
  guides(color=guide_legend(nrow=2,byrow=TRUE)) +
  labs(y = "Deaths (7 day rolling average)", x = "", title = "Long-term scenarios of expected daily deaths", subtitle = "Based on past data and 4 scenarios of growth in cases")

Additional checks

fatality used for model

CZ_fatality %>% 
  ggplot(aes(x = age_category, y = fatality, fill = -fatality)) +
  geom_col() +
  scale_y_continuous(labels = percent_format()) +
  theme_light() +
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank(),
        legend.position = "none")

Expected Deaths based on todays cases

CZ_expected_deaths_timeline_summary <- CZ_expected_deaths_timeline %>%
  mutate(month = month(date_expected_death)) %>%
  group_by(month) %>%
  summarise(expected_deaths = sum(expected_deaths))

CZ_expected_deaths_timeline %>% 
  left_join(CZ_all, by = c("date_expected_death" = "date")) %>%
  ggplot(aes(x = date_expected_death, y = expected_deaths_7)) +
  geom_line(col = "brown", size = 1) +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = new_deaths_7), col = "black", size = 1) +
  geom_vline(xintercept = date_today, col = "red", linetype = "dashed") +
  scale_x_date(date_breaks = "1 month", date_minor_breaks = "1 week", date_labels="%B") +
  theme_light() +
  theme(panel.grid.minor = element_blank()) +
  labs(y = "Deaths (7 day rolling average)", x = "", title = "Expected daily deaths (brown) vs actual deaths (black)", subtitle = "Based solely on cases registered as of today")

Expected Deaths by age category

CZ_expected_deaths_timeline_by_age %>% 
  filter(date < date_today - 7) %>%
  left_join(CZ_deaths_by_age, by = c("date", "age_category")) %>%
  ggplot(aes(x = date, y = expected_deaths_7, group = age_category)) +
  geom_line(col = "brown") +
  #geom_line(aes(y = expected_deaths), col = "grey10") +
  geom_line(aes(y = deaths_7), col = "black") +
  geom_vline(xintercept = date_today, col = "red", linetype = "dashed") +
  theme_light() + 
  facet_wrap(~ age_category) +
  theme(panel.grid.minor = element_blank(),
        panel.grid.major.x = element_blank()) +
  labs(y = "deaths (7 day rolling average)", x = "date", title = "Expected deaths (brown) vs actual deaths (black)", subtitle = "As of 7 days ago, due to reporting delays")